home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 2002 November / SGI Freeware 2002 November - Disc 2.iso / dist / fw_groff.idb / usr / freeware / bin / mmroff.z / mmroff
Text File  |  2002-04-08  |  3KB  |  135 lines
  1. #!/usr/bin/perl5
  2.  
  3. use strict;
  4. # runs groff in safe mode, that seems to be the default
  5. # installation now. That means that I have to fix all nice
  6. # features outside groff. Sigh.
  7. # I do agree however that the previous way opened a whole bunch
  8. # of security holes.
  9.  
  10. my $no_exec;
  11. # check for -x and remove it
  12. if (grep(/^-x$/, @ARGV)) {
  13.     $no_exec++;
  14.     @ARGV = grep(!/^-x$/, @ARGV);
  15. }
  16.  
  17. my $check_macro = "groff -rRef=1 -z @ARGV";
  18. my $run_macro = "groff  @ARGV";
  19.  
  20. my (%cur, $rfilename, $max_height, $imacro, $max_width, @out, @indi);
  21. open(MACRO, "$check_macro 2>&1 |") || die "run $check_macro:$!";
  22. while(<MACRO>) {
  23.     if (m#^\.\\" Rfilename: (\S+)#) {
  24.         # remove all directories just to be more secure
  25.         ($rfilename = $1) =~ s#.*/##;
  26.         next;
  27.     }
  28.     if (m#^\.\\" Imacro: (\S+)#) {
  29.         # remove all directories just to be more secure
  30.         ($imacro = $1) =~ s#.*/##;
  31.         next;
  32.     }
  33.     if (m#^\.\\" Index: (\S+)#) {
  34.         # remove all directories just to be more secure
  35.         my $f;
  36.         ($f = $1) =~ s#.*/##;
  37.         &print_index($f, \@indi, $imacro);
  38.         @indi = ();
  39.         $imacro = '';
  40.         next;
  41.     }
  42.     my $x;
  43.     if (($x) = m#^\.\\" IND (.+)#) {
  44.         $x =~ s#\\##g;
  45.         my @x = split(/\t/, $x);
  46.         grep(s/\s+$//, @x);
  47.         push(@indi, join("\t", @x));
  48.         next;
  49.     }
  50.     if (m#^\.\\" PIC id (\d+)#) {
  51.         %cur = ('id', $1);
  52.         next;
  53.     }
  54.     if (m#^\.\\" PIC file (\S+)#) {
  55.         &psbb($1);
  56.         &ps_calc($1);
  57.         next;
  58.     }
  59.     if (m#^\.\\" PIC (\w+)\s+(\S+)#) {
  60.         eval "\$cur{'$1'} = '$2'";
  61.         next;
  62.     }
  63.     s#\\ \\ $##;
  64.     push(@out, $_);
  65. }
  66. close(MACRO);
  67.  
  68.  
  69. if ($rfilename && @out) {
  70.     push(@out, ".nr pict*max-height $max_height\n") if defined $max_height;
  71.     push(@out, ".nr pict*max-width $max_width\n") if defined $max_width;
  72.  
  73.     open(OUT, ">$rfilename") || "create $rfilename:$!";
  74.     my $i;
  75.     for $i (@out) {
  76.         print OUT $i;
  77.     }
  78.     close(OUT);
  79. }
  80.  
  81. exit 0 if $no_exec;
  82. exit system($run_macro);
  83.  
  84. sub print_index {
  85.     my ($f, $ind, $macro) = @_;
  86.  
  87.     open(OUT, ">$f") || "create $f:$!";
  88.     my $i;
  89.     for $i (sort @$ind) {
  90.         if ($macro) {
  91.             $i = '.'.$macro.' "'.join('" "', split(/\t/, $i)).'"';
  92.         }
  93.         print OUT "$i\n";
  94.     }
  95.     close(OUT);
  96. }
  97.  
  98. sub ps_calc {
  99.     my ($f) = @_;
  100.  
  101.     my $w = abs($cur{'llx'}-$cur{'urx'});
  102.     my $h = abs($cur{'lly'}-$cur{'ury'});
  103.     $max_width = $w if $w > $max_width;
  104.     $max_height = $h if $h > $max_height;
  105.  
  106.     my $id = $cur{'id'};
  107.     push(@out, ".ds pict*file!$id $f\n");
  108.     push(@out, ".ds pict*id!$f $id\n");
  109.     push(@out, ".nr pict*llx!$id $cur{'llx'}\n");
  110.     push(@out, ".nr pict*lly!$id $cur{'lly'}\n");
  111.     push(@out, ".nr pict*urx!$id $cur{'urx'}\n");
  112.     push(@out, ".nr pict*ury!$id $cur{'ury'}\n");
  113.     push(@out, ".nr pict*w!$id $w\n");
  114.     push(@out, ".nr pict*h!$id $h\n");
  115. }
  116.         
  117.  
  118. sub psbb {
  119.     my ($f) = @_;
  120.  
  121.     unless (open(IN, $f)) {
  122.         print STDERR "Warning: Postscript file $f:$!";
  123.         next;
  124.     }
  125.     while(<IN>) {
  126.         if (/^%%BoundingBox:\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)/) {
  127.             $cur{'llx'} = $1;
  128.             $cur{'lly'} = $2;
  129.             $cur{'urx'} = $3;
  130.             $cur{'ury'} = $4;
  131.         }
  132.     }
  133.     close(IN);
  134. }
  135.